home *** CD-ROM | disk | FTP | other *** search
/ Mac Power 1997 October / MACPOWER-1997-10.ISO.7z / MACPOWER-1997-10.ISO / AMUG / PROGRAMMING / Mac F2C 1.3.5.sit / Mac F2C 1.3.5 / Mac F2C Libraries / libI77 Sources / open.c < prev    next >
Text File  |  1995-10-16  |  5KB  |  240 lines
  1. #ifndef NON_UNIX_STDIO
  2. #include "sys/types.h"
  3. #include "sys/stat.h"
  4. #endif
  5. #include "f2c.h"
  6. #include "fio.h"
  7. #include "string.h"
  8. #include "rawio.h"
  9.  
  10. #ifdef KR_headers
  11. extern char *malloc(), *mktemp();
  12. extern integer f_clos();
  13. #else
  14. #undef abs
  15. #undef min
  16. #undef max
  17. #include "stdlib.h"
  18. extern int f__canseek(FILE*);
  19. extern integer f_clos(cllist*);
  20. #endif
  21.  
  22. #ifdef NON_ANSI_RW_MODES
  23. char *f__r_mode[2] = {"r", "r"};
  24. char *f__w_mode[4] = {"w", "w", "r+w", "r+w"};
  25. #else
  26. char *f__r_mode[2] = {"rb", "r"};
  27. char *f__w_mode[4] = {"wb", "w", "r+b", "r+"};
  28. #endif
  29.  
  30. #ifdef KR_headers
  31. f__isdev(s) char *s;
  32. #else
  33. f__isdev(char *s)
  34. #endif
  35. {
  36. #ifdef NON_UNIX_STDIO
  37.     int i, j;
  38.  
  39.     i = open(s,O_RDONLY);
  40.     if (i == -1)
  41.         return 0;
  42.     j = isatty(i);
  43.     close(i);
  44.     return j;
  45. #else
  46.     struct stat x;
  47.  
  48.     if(stat(s, &x) == -1) return(0);
  49. #ifdef S_IFMT
  50.     switch(x.st_mode&S_IFMT) {
  51.         case S_IFREG:
  52.         case S_IFDIR:
  53.             return(0);
  54.         }
  55. #else
  56. #ifdef S_ISREG
  57.     /* POSIX version */
  58.     if(S_ISREG(x.st_mode) || S_ISDIR(x.st_mode))
  59.         return(0);
  60.     else
  61. #else
  62.     Help! How does stat work on this system?
  63. #endif
  64. #endif
  65.         return(1);
  66. #endif
  67. }
  68. #ifdef KR_headers
  69. integer f_open(a) olist *a;
  70. #else
  71. integer f_open(olist *a)
  72. #endif
  73. {    unit *b;
  74.     integer rv;
  75.     char buf[256], *s;
  76.     cllist x;
  77.     int ufmt;
  78. #ifdef NON_UNIX_STDIO
  79.     FILE *tf;
  80. #else
  81.     int n;
  82.     struct stat stb;
  83. #endif
  84.  
  85.     if(a->ounit>=MXUNIT || a->ounit<0)
  86.         err(a->oerr,101,"open")
  87.     f__curunit = b = &f__units[a->ounit];
  88.     if(b->ufd) {
  89.         if(a->ofnm==0)
  90.         {
  91.         same:    if (a->oblnk)
  92.                 b->ublnk = *a->oblnk == 'z' || *a->oblnk == 'Z';
  93.             return(0);
  94.         }
  95. #ifdef NON_UNIX_STDIO
  96.         if (b->ufnm
  97.          && strlen(b->ufnm) == a->ofnmlen
  98.          && !strncmp(b->ufnm, b->ufnm, (unsigned)a->ofnmlen))
  99.             goto same;
  100. #else
  101.         g_char(a->ofnm,a->ofnmlen,buf);
  102.         if (f__inode(buf,&n) == b->uinode && n == b->udev)
  103.             goto same;
  104. #endif
  105.         x.cunit=a->ounit;
  106.         x.csta=0;
  107.         x.cerr=a->oerr;
  108.         if ((rv = f_clos(&x)) != 0)
  109.             return rv;
  110.         }
  111.     b->url = (int)a->orl;
  112.     b->ublnk = a->oblnk && (*a->oblnk == 'z' || *a->oblnk == 'Z');
  113.     if(a->ofm==0)
  114.     {    if(b->url>0) b->ufmt=0;
  115.         else b->ufmt=1;
  116.     }
  117.     else if(*a->ofm=='f' || *a->ofm == 'F') b->ufmt=1;
  118.     else b->ufmt=0;
  119.     ufmt = b->ufmt;
  120. #ifdef url_Adjust
  121.     if (b->url && !ufmt)
  122.         url_Adjust(b->url);
  123. #endif
  124.     if (a->ofnm) {
  125.         g_char(a->ofnm,a->ofnmlen,buf);
  126.         if (!buf[0])
  127.             err(a->oerr,107,"open")
  128.         }
  129.     else
  130.         sprintf(buf, "fort.%ld", a->ounit);
  131.     b->uscrtch = 0;
  132.     switch(a->osta ? *a->osta : 'u')
  133.     {
  134.     case 'o':
  135.     case 'O':
  136. #ifdef NON_UNIX_STDIO
  137.         if(access(buf,0))
  138. #else
  139.         if(stat(buf,&stb))
  140. #endif
  141. //        err(a->oerr,errno,"open")        /* Bug!!!! */
  142.         err( a->oerr, 107, "open" )        /* IMT 20Sep95 Bug fix */
  143.         break;
  144.      case 's':
  145.      case 'S':
  146.         b->uscrtch=1;
  147. #ifdef _POSIX_SOURCE
  148.         tmpnam(buf);
  149. #else
  150.         (void) strcpy(buf,"tmp.FXXXXXX");
  151.         (void) mktemp(buf);
  152. #endif
  153.         goto replace;
  154.     case 'n':
  155.     case 'N':
  156. #ifdef NON_UNIX_STDIO
  157.         if(!access(buf,0))
  158. #else
  159.         if(!stat(buf,&stb))
  160. #endif
  161.             err(a->oerr,128,"open")
  162.         /* no break */
  163.     case 'r':    /* Fortran 90 replace option */
  164.     case 'R':
  165.  replace:
  166. #ifdef NON_UNIX_STDIO
  167.         if (tf = fopen(buf,f__w_mode[0]))
  168.             fclose(tf);
  169. #else
  170.         (void) close(creat(buf, 0666));
  171. #endif
  172.     }
  173.  
  174.     b->ufnm=(char *) malloc((unsigned int)(strlen(buf)+1));
  175.     if(b->ufnm==NULL) err(a->oerr,113,"no space");
  176.     (void) strcpy(b->ufnm,buf);
  177.     b->uend=0;
  178.     b->uwrt = 0;
  179. #ifdef NON_UNIX_STDIO
  180.     if ((s = a->oacc) && (*s == 'd' || *s == 'D'))
  181.         ufmt = 0;
  182. #endif
  183.     if(f__isdev(buf))
  184.     {    b->ufd = fopen(buf,f__r_mode[ufmt]);
  185.         if(b->ufd==NULL) err(a->oerr,errno,buf)
  186.     }
  187.     else {
  188.         if(!(b->ufd = fopen(buf, f__r_mode[ufmt]))) {
  189. #ifdef NON_UNIX_STDIO
  190.             if (b->ufd = fopen(buf, f__w_mode[ufmt|2]))
  191.                 b->uwrt = 2;
  192.             else if (b->ufd = fopen(buf, f__w_mode[ufmt]))
  193.                 b->uwrt = 1;
  194.             else
  195. #else
  196.             if ((n = open(buf,O_WRONLY)) >= 0)
  197.                 b->uwrt = 2;
  198.             else {
  199.                 n = creat(buf, 0666);
  200.                 b->uwrt = 1;
  201.                 }
  202.             if (n < 0
  203.             || (b->ufd = fdopen(n, f__w_mode[ufmt])) == NULL)
  204. #endif
  205.                 err(a->oerr, errno, "open");
  206.             }
  207.     }
  208.     b->useek=f__canseek(b->ufd);
  209. #ifndef NON_UNIX_STDIO
  210.     if((b->uinode=f__inode(buf,&b->udev))==-1)
  211.         err(a->oerr,108,"open")
  212. #endif
  213.     if(b->useek)
  214.         if (a->orl)
  215.             rewind(b->ufd);
  216.         else if ((s = a->oacc) && (*s == 'a' || *s == 'A')
  217.             && fseek(b->ufd, 0L, SEEK_END))
  218.                 err(a->oerr,129,"open");
  219.     return(0);
  220. }
  221. #ifdef KR_headers
  222. fk_open(seq,fmt,n) ftnint n;
  223. #else
  224. fk_open(int seq, int fmt, ftnint n)
  225. #endif
  226. {    char nbuf[10];
  227.     olist a;
  228.     (void) sprintf(nbuf,"fort.%ld",n);
  229.     a.oerr=1;
  230.     a.ounit=n;
  231.     a.ofnm=nbuf;
  232.     a.ofnmlen=strlen(nbuf);
  233.     a.osta=NULL;
  234.     a.oacc= seq==SEQ?"s":"d";
  235.     a.ofm = fmt==FMT?"f":"u";
  236.     a.orl = seq==DIR?1:0;
  237.     a.oblnk=NULL;
  238.     return(f_open(&a));
  239. }
  240.